perm filename SOLN5.S79[206,LSP] blob
sn#449546 filedate 1979-06-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 Here is the LISP source code required to answer HomeWork Set 5
C00011 00003 Output -- the result of
C00040 00004 Solution to Question #2 [Pattern Matching]
C00045 00005 This is the function which does most of the work.
C00047 00006 To show that *variables are handled correctly, MTCH?-1 was traced:
C00049 00007 Solution to Question #3 [Error correcting]
C00050 00008 Solution to Question #4 [Self-Generation]
C00051 00009 Solution to Question #5 [New LISP Cells]
C00053 00010 Solution to Question #6 [Auxilary Functions]
C00055 00011 Solution to Question #7 [Ordering]
C00059 ENDMK
C⊗;
; Here is the LISP source code required to answer HomeWork Set 5
; Spring 1979
; Solution to Question #1 [diagnosing]
;; The following functions do the work
(DEFUN PRETTY-OUT (PATS DISS)
(MAPC '(LAMBDA (A-PAT)
(TERPRI)
(PRINC (CAR A-PAT)) (PRINC ':) (TERPRI)
(MAPC '(LAMBDA (A-REQUIRE)
(PRINC '| |)
(PRINC (CAR A-REQUIRE))
(PRINC ':)
(MAPC '(LAMBDA (DIS) (PRINC '| |) (PRINC DIS))
(CDR A-REQUIRE))
(TERPRI))
(ORGANIZE (CDR A-PAT))))
(DIAGNOSES PATS DISS))
'*)
(DEFUN DIAGNOSES (PATS DISS)
(MAPCAR
'(LAMBDA (A-PAT)
(CONS A-PAT
(MAPCAR
'(LAMBDA (A-DIS)
(CONS A-DIS
(PROBABLY-HAS A-PAT A-DIS)))
DISS)))
PATS))
(DEFUN PROBABLY-HAS (PAT DIS)
; This returns the likelihood the patient PAT has the disease DIS
((LAMBDA (VALUE)
(MAPC '(LAMBDA (A-SYMP)
(SETQ VALUE (TEST-1 PAT A-SYMP VALUE)))
(GET DIS 'SYMPTOM))
VALUE)
; so this gets returned
1.0))
(DEFUN TEST-1 (PAT SYMP VAL)
; Updates the likelihood value, VAL
; based on "probability" the patient PAT has sympton, SYMP
((LAMBDA (PROB REQUIRE)
(COND ((EQ REQUIRE 'MUST-BE) (TIMES VAL PROB))
((EQ REQUIRE 'MUST-NOT-BE)
(DIFFERENCE 1.0 (TIMES VAL (DIFFERENCE 1.0 PROB))))
(T (ERROR-1 (LIST '|I do NOT recognize condition |
REQUIRE)))))
(FUNCALL (CAR SYMP) PAT)
(CDR SYMP)))
(DEFUN ERROR-1 (X) (MAPC 'PRINC X) (TERPRI) NIL)
(DEFUN ORGANIZE (PAT-REC)
((LAMBDA (ALL-DISEASES)
(MAPC '(LAMBDA (ELEM) ((LAMBDA (NAME-REC)
(RPLACD NAME-REC
(CONS (CAR ELEM) (CDR NAME-REC))))
(ASSQ (NAME-OF (CDR ELEM)) ALL-DISEASES)))
PAT-REC)
ALL-DISEASES) ; so this is returned
(LIST (LIST 'DEFINATELY)
(LIST 'PROBABLY)
(LIST 'MIGHT)
(LIST 'PROBABLY-NOT)
(LIST 'DEFINATELY-NOT)))
)
(DEFUN NAME-OF (VALUE)
(COND ((NOT (NUMBERP VALUE)) '|.undefined.not-number.|)
((> VALUE 1.0) '|.undefined.over.|)
((< VALUE 0.0) '|.undefined.under.|)
((> VALUE 0.9) 'DEFINATELY)
((> VALUE 0.6) 'PROBABLY)
((> VALUE 0.4) 'MIGHT)
((> VALUE 0.1) 'PROBABLY-NOT)
(T 'DEFINATELY-NOT)))
; Output -- the result of
(PRETTY-OUT PATIENTS DISEASES)
RDG:
DEFINATELY: COLD ITERATIVE-ITIS
PROBABLY: BACKGAMMON-ITIS CHESS-ITIS FOOT-IN-MOUTH VERBOSITY
MIGHT: HEALTHY FEAR-OF-FRYING LACONIC
PROBABLY-NOT: HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX FEAR-OF-FLYING
MIDAS-TOUCH FAIL-LISP-CLASS RECURSIVE-ITIS BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES INSANITY STOMACHACHE CUTENESS
TOOTHACHE
DBL:
DEFINATELY: COLD BACKGAMMON-ITIS VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX
FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH RECURSIVE-ITIS BROKEN-LEG
SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES STOMACHACHE TOOTHACHE
BCM:
DEFINATELY: BACKGAMMON-ITIS FEAR-OF-FRYING LACONIC VERBOSITY ITERATIVE-ITIS
PROBABLY: HEALTHY COLD INSANITY CHESS-ITIS FOOT-IN-MOUTH CUTENESS
MIGHT: GERMAN-MEASLES DIPHTHERIA CHICKEN-POX FAIL-LISP-CLASS SNFEVER
PROBABLY-NOT: HEPATITUS SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA MONONUCLEOSIS FEAR-OF-FLYING MIDAS-TOUCH BROKEN-LEG
DEFINATELY-NOT: HAYFEVER STOMACHACHE RECURSIVE-ITIS TOOTHACHE
CLEOPATRA:
DEFINATELY: CHICKEN-POX BACKGAMMON-ITIS VERBOSITY
PROBABLY: COLD INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: HEPATITUS SMALL-POX MEASLES LACONIC CUTENESS FAIL-LISP-CLASS
SNFEVER
PROBABLY-NOT: HEALTHY SCARLET-FEVER POLIOMYELITIS MUMPS INFLUENZA MONONUCLEOSIS
GERMAN-MEASLES DIPHTHERIA FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH
STOMACHACHE TOOTHACHE BROKEN-LEG
DEFINATELY-NOT: HAYFEVER RECURSIVE-ITIS
DOLLAR:
DEFINATELY: COLD MIDAS-TOUCH ITERATIVE-ITIS
PROBABLY: BACKGAMMON-ITIS CHESS-ITIS FOOT-IN-MOUTH VERBOSITY
MIGHT: HEALTHY LACONIC
PROBABLY-NOT: MONONUCLEOSIS GERMAN-MEASLES FEAR-OF-FRYING FEAR-OF-FLYING
CUTENESS FAIL-LISP-CLASS RECURSIVE-ITIS BROKEN-LEG
DEFINATELY-NOT: HAYFEVER HEPATITUS SMALL-POX SCARLET-FEVER POLIOMYELITIS
MUMPS MEASLES INFLUENZA DIPHTHERIA CHICKEN-POX INSANITY STOMACHACHE
TOOTHACHE SNFEVER
ICARUS:
DEFINATELY: COLD BACKGAMMON-ITIS FEAR-OF-FLYING VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX
FEAR-OF-FRYING MIDAS-TOUCH BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES STOMACHACHE RECURSIVE-ITIS TOOTHACHE
FISHER:
DEFINATELY: COLD BACKGAMMON-ITIS VERBOSITY
PROBABLY: INSANITY FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: CHESS-ITIS LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY MONONUCLEOSIS FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH
BROKEN-LEG
DEFINATELY-NOT: HAYFEVER HEPATITUS SMALL-POX SCARLET-FEVER POLIOMYELITIS
MUMPS MEASLES INFLUENZA GERMAN-MEASLES DIPHTHERIA CHICKEN-POX
STOMACHACHE RECURSIVE-ITIS TOOTHACHE SNFEVER
PAULING:
DEFINATELY: COLD HAYFEVER BACKGAMMON-ITIS VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: HEPATITUS MEASLES INFLUENZA LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MONONUCLEOSIS GERMAN-MEASLES DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING
FEAR-OF-FLYING MIDAS-TOUCH STOMACHACHE TOOTHACHE BROKEN-LEG SNFEVER
DEFINATELY-NOT: RECURSIVE-ITIS
BIGMOUTH:
DEFINATELY: COLD ITERATIVE-ITIS
PROBABLY: BACKGAMMON-ITIS CHESS-ITIS
MIGHT: HEALTHY LACONIC VERBOSITY
PROBABLY-NOT: HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING
FEAR-OF-FLYING MIDAS-TOUCH CUTENESS FAIL-LISP-CLASS RECURSIVE-ITIS
TOOTHACHE BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES INSANITY STOMACHACHE FOOT-IN-MOUTH
BIGMOUTH2:
DEFINATELY: COLD LACONIC VERBOSITY ITERATIVE-ITIS
PROBABLY: BACKGAMMON-ITIS CHESS-ITIS
MIGHT: HEALTHY
PROBABLY-NOT: HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING
FEAR-OF-FLYING MIDAS-TOUCH CUTENESS FAIL-LISP-CLASS RECURSIVE-ITIS
TOOTHACHE BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES INSANITY STOMACHACHE FOOT-IN-MOUTH
NOTHING:
DEFINATELY: COLD BACKGAMMON-ITIS VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX
FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES STOMACHACHE RECURSIVE-ITIS TOOTHACHE
DIRTYNEEDLE:
DEFINATELY: HEPATITUS BACKGAMMON-ITIS VERBOSITY
PROBABLY: COLD INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS MEASLES
INFLUENZA MONONUCLEOSIS DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING
FEAR-OF-FLYING MIDAS-TOUCH BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER GERMAN-MEASLES STOMACHACHE RECURSIVE-ITIS TOOTHACHE
SMALLTALK:
DEFINATELY: COLD BACKGAMMON-ITIS LACONIC VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS MONONUCLEOSIS DIPHTHERIA CHICKEN-POX
FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA GERMAN-MEASLES STOMACHACHE RECURSIVE-ITIS TOOTHACHE
ROBBERBARON:
DEFINATELY: COLD GERMAN-MEASLES BACKGAMMON-ITIS VERBOSITY
PROBABLY: INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: SMALL-POX SCARLET-FEVER CHICKEN-POX LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS POLIOMYELITIS MUMPS MEASLES INFLUENZA
MONONUCLEOSIS DIPHTHERIA FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH
BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER STOMACHACHE RECURSIVE-ITIS TOOTHACHE
SICKIE:
DEFINATELY: BACKGAMMON-ITIS VERBOSITY
PROBABLY: COLD INSANITY CHESS-ITIS FOOT-IN-MOUTH
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEPATITUS SMALL-POX SCARLET-FEVER POLIOMYELITIS MUMPS
MEASLES INFLUENZA MONONUCLEOSIS DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING
FEAR-OF-FLYING MIDAS-TOUCH ITERATIVE-ITIS RECURSIVE-ITIS BROKEN-LEG
SNFEVER
DEFINATELY-NOT: HEALTHY HAYFEVER GERMAN-MEASLES STOMACHACHE TOOTHACHE
MRHANGOVER:
DEFINATELY: BACKGAMMON-ITIS STOMACHACHE VERBOSITY TOOTHACHE
PROBABLY: COLD INSANITY CHESS-ITIS FOOT-IN-MOUTH ITERATIVE-ITIS
MIGHT: LACONIC CUTENESS FAIL-LISP-CLASS
PROBABLY-NOT: HEALTHY HEPATITUS POLIOMYELITIS MEASLES INFLUENZA MONONUCLEOSIS
DIPHTHERIA CHICKEN-POX FEAR-OF-FRYING FEAR-OF-FLYING MIDAS-TOUCH
BROKEN-LEG SNFEVER
DEFINATELY-NOT: HAYFEVER SMALL-POX SCARLET-FEVER MUMPS GERMAN-MEASLES
RECURSIVE-ITIS
*
; Note: Just (DIAGNOSES PATIENTS DISEASES) would give
((RDG (SNFEVER . 0.125) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.125) (ITERATIVE-ITIS . 0.975)
(FAIL-LISP-CLASS . 0.125) (CUTENESS . 0.0) (VERBOSITY .
0.75) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.75) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 0.5) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.875) (INSANITY . 0.0) (CHICKEN-POX . 0.125) (DIPHTHERIA .
0.125) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0625) (MEASLES . 0.0625) (MUMPS . 0.0625) (POLIOMYELITIS .
0.0625) (SCARLET-FEVER . 0.0625) (SMALL-POX . 0.0625) (HEPATITUS .
0.125) (HAYFEVER . 0.03125) (COLD . 0.9375) (HEALTHY .
0.5328125)) (DBL (SNFEVER . 0.15) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.25) (ITERATIVE-ITIS . 0.75)
(FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.15) (DIPHTHERIA .
0.15) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.075) (MEASLES . 0.075) (MUMPS . 0.075) (POLIOMYELITIS .
0.075) (SCARLET-FEVER . 0.075) (SMALL-POX . 0.075) (HEPATITUS .
0.15) (HAYFEVER . 0.03125) (COLD . 0.925) (HEALTHY .
0.3328125)) (BCM (SNFEVER . 0.5) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS .
1.0) (FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.875) (VERBOSITY .
1.0) (LACONIC . 1.0) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 1.0) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.5) (DIPHTHERIA .
0.5) (GERMAN-MEASLES . 0.5) (MONONUCLEOSIS . 0.25) (INFLUENZA .
0.125) (MEASLES . 0.25) (MUMPS . 0.25) (POLIOMYELITIS .
0.25) (SCARLET-FEVER . 0.25) (SMALL-POX . 0.25) (HEPATITUS .
0.25) (HAYFEVER . 0.0625) (COLD . 0.875) (HEALTHY .
0.6875)) (CLEOPATRA (SNFEVER . 0.5) (BROKEN-LEG . 0.25) (TOOTHACHE .
0.125) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS . 0.71875)
(FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.125) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25) (FEAR-OF-FRYING .
0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS . 0.9375) (INSANITY .
0.75) (CHICKEN-POX . 1.0) (DIPHTHERIA . 0.25) (GERMAN-MEASLES .
0.25) (MONONUCLEOSIS . 0.25) (INFLUENZA . 0.25) (MEASLES .
0.5) (MUMPS . 0.25) (POLIOMYELITIS . 0.25) (SCARLET-FEVER .
0.25) (SMALL-POX . 0.5) (HEPATITUS . 0.5) (HAYFEVER .
0.0625) (COLD . 0.75) (HEALTHY . 0.25)) (DOLLAR (SNFEVER .
0.0) (BROKEN-LEG . 0.125) (TOOTHACHE . 0.0625) (RECURSIVE-ITIS .
0.125) (ITERATIVE-ITIS . 0.975) (FAIL-LISP-CLASS . 0.125) (CUTENESS .
0.375) (VERBOSITY . 0.875) (LACONIC . 0.5) (FOOT-IN-MOUTH .
0.75) (STOMACHACHE . 0.0625) (MIDAS-TOUCH . 1.0) (FEAR-OF-FLYING .
0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.875) (INSANITY . 0.0) (CHICKEN-POX . 0.0) (DIPHTHERIA .
0.0) (GERMAN-MEASLES . 0.125) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0) (MEASLES . 0.0) (MUMPS . 0.0) (POLIOMYELITIS .
0.0) (SCARLET-FEVER . 0.0) (SMALL-POX . 0.0) (HEPATITUS .
0.0) (HAYFEVER . 0.0625) (COLD . 1.0) (HEALTHY . 0.525)) (ICARUS
(SNFEVER . 0.125) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS .
0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 1.0) (FEAR-OF-FRYING .
0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS . 0.9375) (INSANITY .
0.75) (CHICKEN-POX . 0.125) (DIPHTHERIA . 0.125) (GERMAN-MEASLES .
0.0625) (MONONUCLEOSIS . 0.25) (INFLUENZA . 0.0625) (MEASLES .
0.0625) (MUMPS . 0.0625) (POLIOMYELITIS . 0.0625) (SCARLET-FEVER .
0.0625) (SMALL-POX . 0.0625) (HEPATITUS . 0.25) (HAYFEVER .
0.03125) (COLD . 0.9375) (HEALTHY . 0.333007813)) (FISHER (SNFEVER .
0.0) (BROKEN-LEG . 0.125) (TOOTHACHE . 0.0625) (RECURSIVE-ITIS .
0.0625) (ITERATIVE-ITIS . 0.71875) (FAIL-LISP-CLASS .
0.5625) (CUTENESS . 0.4375) (VERBOSITY . 0.9375) (LACONIC .
0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE . 0.0625) (MIDAS-TOUCH .
0.125) (FEAR-OF-FLYING . 0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS .
0.5) (BACKGAMMON-ITIS . 1.0) (INSANITY . 0.75) (CHICKEN-POX .
0.0) (DIPHTHERIA . 0.0) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS .
0.125) (INFLUENZA . 0.0) (MEASLES . 0.0) (MUMPS . 0.0)
(POLIOMYELITIS . 0.0) (SCARLET-FEVER . 0.0) (SMALL-POX .
0.0) (HEPATITUS . 0.0) (HAYFEVER . 0.03125) (COLD .
1.0) (HEALTHY . 0.333984375)) (PAULING (SNFEVER . 0.25) (BROKEN-LEG .
0.25) (TOOTHACHE . 0.125) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS .
0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.125) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25) (FEAR-OF-FRYING .
0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS . 0.9375) (INSANITY .
0.75) (CHICKEN-POX . 0.25) (DIPHTHERIA . 0.25) (GERMAN-MEASLES .
0.125) (MONONUCLEOSIS . 0.25) (INFLUENZA . 0.5) (MEASLES .
0.5) (MUMPS . 0.125) (POLIOMYELITIS . 0.25) (SCARLET-FEVER .
0.125) (SMALL-POX . 0.125) (HEPATITUS . 0.5) (HAYFEVER .
1.0) (COLD . 1.0) (HEALTHY . 0.25)) (BIGMOUTH (SNFEVER .
0.125) (BROKEN-LEG . 0.25) (TOOTHACHE . 0.125) (RECURSIVE-ITIS .
0.125) (ITERATIVE-ITIS . 0.975) (FAIL-LISP-CLASS . 0.125) (CUTENESS .
0.25) (VERBOSITY . 0.5) (LACONIC . 0.5) (FOOT-IN-MOUTH .
0.0) (STOMACHACHE . 0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING .
0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.875) (INSANITY . 0.0) (CHICKEN-POX . 0.125) (DIPHTHERIA .
0.125) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0625) (MEASLES . 0.0625) (MUMPS . 0.0625) (POLIOMYELITIS .
0.0625) (SCARLET-FEVER . 0.0625) (SMALL-POX . 0.0625) (HEPATITUS .
0.125) (HAYFEVER . 0.03125) (COLD . 0.9375) (HEALTHY .
0.5328125)) (BIGMOUTH2 (SNFEVER . 0.125) (BROKEN-LEG .
0.25) (TOOTHACHE . 0.125) (RECURSIVE-ITIS . 0.125) (ITERATIVE-ITIS .
0.975) (FAIL-LISP-CLASS . 0.125) (CUTENESS . 0.25) (VERBOSITY .
1.0) (LACONIC . 1.0) (FOOT-IN-MOUTH . 0.0) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.875) (INSANITY . 0.0) (CHICKEN-POX . 0.125) (DIPHTHERIA .
0.125) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0625) (MEASLES . 0.0625) (MUMPS . 0.0625) (POLIOMYELITIS .
0.0625) (SCARLET-FEVER . 0.0625) (SMALL-POX . 0.0625) (HEPATITUS .
0.125) (HAYFEVER . 0.03125) (COLD . 0.9375) (HEALTHY .
0.5328125)) (NOTHING (SNFEVER . 0.125) (BROKEN-LEG .
0.125) (TOOTHACHE . 0.0625) (RECURSIVE-ITIS . 0.0625)
(ITERATIVE-ITIS . 0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS .
0.4375) (VERBOSITY . 0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH .
0.875) (STOMACHACHE . 0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING .
0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.125) (DIPHTHERIA .
0.125) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0625) (MEASLES . 0.0625) (MUMPS . 0.0625) (POLIOMYELITIS .
0.0625) (SCARLET-FEVER . 0.0625) (SMALL-POX . 0.0625) (HEPATITUS .
0.125) (HAYFEVER . 0.03125) (COLD . 0.9375) (HEALTHY .
0.333007813)) (DIRTYNEEDLE (SNFEVER . 0.25) (BROKEN-LEG .
0.125) (TOOTHACHE . 0.0625) (RECURSIVE-ITIS . 0.0625)
(ITERATIVE-ITIS . 0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS .
0.4375) (VERBOSITY . 0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH .
0.875) (STOMACHACHE . 0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING .
0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.25) (DIPHTHERIA .
0.25) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.25) (INFLUENZA .
0.125) (MEASLES . 0.125) (MUMPS . 0.125) (POLIOMYELITIS .
0.125) (SCARLET-FEVER . 0.125) (SMALL-POX . 0.125) (HEPATITUS .
1.0) (HAYFEVER . 0.03125) (COLD . 0.875) (HEALTHY .
0.375)) (SMALLTALK (SNFEVER . 0.125) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS .
0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
1.0) (LACONIC . 1.0) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.125) (DIPHTHERIA .
0.125) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.0625) (MEASLES . 0.0625) (MUMPS . 0.0625) (POLIOMYELITIS .
0.0625) (SCARLET-FEVER . 0.0625) (SMALL-POX . 0.0625) (HEPATITUS .
0.125) (HAYFEVER . 0.03125) (COLD . 0.9375) (HEALTHY .
0.333007813)) (ROBBERBARON (SNFEVER . 0.25) (BROKEN-LEG .
0.125) (TOOTHACHE . 0.0625) (RECURSIVE-ITIS . 0.0625)
(ITERATIVE-ITIS . 0.71875) (FAIL-LISP-CLASS . 0.5625) (CUTENESS .
0.4375) (VERBOSITY . 0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH .
0.875) (STOMACHACHE . 0.0625) (MIDAS-TOUCH . 0.25) (FEAR-OF-FLYING .
0.25) (FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.5) (DIPHTHERIA .
0.25) (GERMAN-MEASLES . 1.0) (MONONUCLEOSIS . 0.25) (INFLUENZA .
0.125) (MEASLES . 0.25) (MUMPS . 0.25) (POLIOMYELITIS .
0.125) (SCARLET-FEVER . 0.5) (SMALL-POX . 0.5) (HEPATITUS .
0.125) (HAYFEVER . 0.0625) (COLD . 0.9375) (HEALTHY .
0.3125)) (SICKIE (SNFEVER . 0.25) (BROKEN-LEG . 0.125) (TOOTHACHE .
0.0625) (RECURSIVE-ITIS . 0.125) (ITERATIVE-ITIS . 0.375)
(FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.875) (STOMACHACHE .
0.0625) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25)
(FEAR-OF-FRYING . 0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS .
0.9375) (INSANITY . 0.75) (CHICKEN-POX . 0.25) (DIPHTHERIA .
0.25) (GERMAN-MEASLES . 0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA .
0.25) (MEASLES . 0.125) (MUMPS . 0.25) (POLIOMYELITIS .
0.125) (SCARLET-FEVER . 0.25) (SMALL-POX . 0.25) (HEPATITUS .
0.25) (HAYFEVER . 0.03125) (COLD . 0.875) (HEALTHY .
0.0)) (MRHANGOVER (SNFEVER . 0.125) (BROKEN-LEG . 0.25) (TOOTHACHE .
1.0) (RECURSIVE-ITIS . 0.0625) (ITERATIVE-ITIS . 0.71875)
(FAIL-LISP-CLASS . 0.5625) (CUTENESS . 0.4375) (VERBOSITY .
0.9375) (LACONIC . 0.5) (FOOT-IN-MOUTH . 0.75) (STOMACHACHE .
1.0) (MIDAS-TOUCH . 0.125) (FEAR-OF-FLYING . 0.25) (FEAR-OF-FRYING .
0.25) (CHESS-ITIS . 0.875) (BACKGAMMON-ITIS . 0.9375) (INSANITY .
0.75) (CHICKEN-POX . 0.125) (DIPHTHERIA . 0.125) (GERMAN-MEASLES .
0.0625) (MONONUCLEOSIS . 0.125) (INFLUENZA . 0.125) (MEASLES .
0.125) (MUMPS . 0.0625) (POLIOMYELITIS . 0.125) (SCARLET-FEVER .
0.0625) (SMALL-POX . 0.0625) (HEPATITUS . 0.125) (HAYFEVER .
0.0625) (COLD . 0.875) (HEALTHY . 0.25)))
; Solution to Question #2 [Pattern Matching]
; Part 1
;; Note that "*" variables essentially LISTIFY away DOTs.
(DEFUN CODE (PAT)
(COND ((ATOM PAT)
(COND ((AND (EQ (TYPEP PAT) 'SYMBOL)
(MEMQ (GETCHAR PAT 1.) '(* ?)))
(SYMEVAL PAT))
(T PAT)))
((AND (EQ (TYPEP (CAR PAT)) 'SYMBOL)
(EQ (GETCHAR (CAR PAT) 1.) '*))
(APPEND (SYMEVAL (CAR PAT)) (CODE (CDR PAT))))
(T (CONS (CODE (CAR PAT)) (CODE (CDR PAT))))))
; Part 2
(DEFUN MTCH? (PAT SEXP)
((LAMBDA (MATCH)
(COND (MATCH (MAPC
; Here the values are set
'(LAMBDA (BP) (SET (CAR BP) (CDR BP)))
(CDR MATCH))
T) ; so T is returned
(T NIL)))
(MTCH?-1 PAT SEXP NIL)))
(DEFUN MTCH-* (*NAME PATT SEXPR BND-LIST)
; This tries various bindings for some *__ variable
((LAMBDA (HERE-ALREADY)
(COND
(HERE-ALREADY
; If it has already been assigned, see if this value is ok.
((LAMBDA (FRT-MTCH) (COND (FRT-MTCH (MTCH?-1 PATT
(CDR FRT-MTCH)
BND-LIST))
(T NIL)))
(EQUAL-FRONT (CDR HERE-ALREADY) SEXPR)))
(T ; Now walk thru the list, trying each binding case.
(DO ((FRST NIL (APPEND FRST (LIST (CAR REST))))
(REST SEXPR (CDR REST))
(DONE NIL (NULL REST))) ; so DONE T only if REST was NIL last loop.
(DONE NIL) ; NIL is returned, unless some value RETURNed
((LAMBDA (TRY) (AND TRY (RETURN TRY)))
(MTCH?-1 PATT
REST
(CONS (CONS *NAME FRST) BND-LIST)))))))
(ASSQ *NAME BND-LIST)))
(DEFUN EQUAL-FRONT (PART LARGER)
; Returns (T . remainder) if PART * REMAINDER = LARGER; else NIL
; Both PART & LARGER are assumed to be LISTS
(COND ((NULL PART) (CONS T LARGER))
((NULL LARGER) NIL)
((EQ (CAR PART) (CAR LARGER))
(EQUAL-FRONT (CDR PART) (CDR LARGER)))
(T NIL)))
; Part 3
(DEFUN MATCHES (PAT SEXP)
(COND ((MTCH? PAT SEXP) (CONS T SEXP))
((ATOM SEXP) NIL) ; ie no hope this will work out.
((MATCHES PAT (CAR SEXP))) ; if non-NIL, this correct result
((MATCHES PAT (CDR SEXP))))) ; try CDR if CAR fails
; This is the function which does most of the work.
(DEFUN MTCH?-1 (PAT SEXP BOUND-LIST)
; BOUND-LIST is list of binding pairs - eg (?a . 5)
; This returns (T . BND-LST) if successful, NIL otherwise
(COND
((ATOM PAT)
(COND
((AND (EQ (TYPEP PAT) 'SYMBOL)
(MEMQ (GETCHAR PAT 1.) '(* ?)))
((LAMBDA (ALREADY-HERE)
(COND (ALREADY-HERE (AND (EQUAL (CDR ALREADY-HERE)
SEXP)
(CONS T BOUND-LIST)))
(T (CONS T
(CONS (CONS PAT SEXP)
BOUND-LIST)))))
(ASSQ PAT BOUND-LIST)))
((EQ PAT SEXP) (CONS T BOUND-LIST))
(T NIL)))
(((LAMBDA (CAR-PAT)
(COND ((ATOM SEXP) NIL)
((AND (EQ (TYPEP CAR-PAT) 'SYMBOL)
(EQ (GETCHAR CAR-PAT 1.) '*))
(MTCH-* CAR-PAT (CDR PAT) SEXP BOUND-LIST))
(T ((LAMBDA (FIRST)
(AND FIRST
(MTCH?-1 (CDR PAT)
(CDR SEXP)
(CDR FIRST))))
(MTCH?-1 CAR-PAT
(CAR SEXP)
BOUND-LIST)))))
(CAR PAT)))))
; To show that *variables are handled correctly, MTCH?-1 was traced:
(MTCH? '(*B IS *B) '(A WORD IS A WORD) )
(1 ENTER MTCH?-1 ((*B IS *B) (A WORD IS A WORD) NIL))
(2 ENTER MTCH?-1 ((IS *B) (A WORD IS A WORD) ((*B))))
(3 ENTER MTCH?-1 (IS A ((*B))))
(3 EXIT MTCH?-1 NIL)
(2 EXIT MTCH?-1 NIL)
(2 ENTER MTCH?-1 ((IS *B) (WORD IS A WORD) ((*B A))))
(3 ENTER MTCH?-1 (IS WORD ((*B A))))
(3 EXIT MTCH?-1 NIL)
(2 EXIT MTCH?-1 NIL)
(2 ENTER MTCH?-1 ((IS *B) (IS A WORD) ((*B A WORD))))
(3 ENTER MTCH?-1 (IS IS ((*B A WORD))))
(3 EXIT MTCH?-1 (T (*B A WORD)))
(3 ENTER MTCH?-1 ((*B) (A WORD) ((*B A WORD))))
(4 ENTER MTCH?-1 (NIL NIL ((*B A WORD))))
(4 EXIT MTCH?-1 (T (*B A WORD)))
(3 EXIT MTCH?-1 (T (*B A WORD)))
(2 EXIT MTCH?-1 (T (*B A WORD)))
(1 EXIT MTCH?-1 (T (*B A WORD))) T
*B
(A WORD)
; Solution to Question #3 [Error correcting]
The basic change required is to modify CODE by changing each
(SYMEVAL ...)
to (COND ((BOUNDP x) (SYMEVAL x))
(T (ERROR-1 (LIST '|I could not evaluate | x))))
It might be a good policy to change MTCH? to investigate whether some variable
had a value assigned to it before reSETting - ie rewriting each
(SET x y)
to (COND ((BOUNDP x) (ERROR-1 (LIST '|The value of | x '| is now | (symeval x))))
(SET x y)
; Solution to Question #4 [Self-Generation]
(SETQ SELF
((LAMBDA (X) (LIST X (LIST 'QUOTE X)))
'(LAMBDA (X) (LIST X (LIST 'QUOTE X))))
)
(EQUAL SELF (EVAL SELF))
T
; Solution to Question #5 [New LISP Cells]
; Note if we assume we are dealing with L-Lists, this problem simplifies
(DEFUN NEW-GUTS (LIST N)
(COND ((OR (ATOM LIST) (ZERO-P N)) LIST)
(T (MAPCAR '(LAMBDA (X)
(NEW-GUTS X (SUB-1 N)))
LIST))))
(DEFUN SUB-1 (NUM)
(COND ((EQ NUM 'INFINITY) 'INFINITY)
((NUMBERP NUM) (SUB1 NUM))
(T (ERROR-1 (LIST '|Illegal "number" | NUM)))))
(DEFUN ZERO-P (NUM)
(AND (NUMBERP NUM) (ZEROP NUM)))
(DEFUN ERROR-1 (X) (MAPC 'PRINC X) (TERPRI) NIL)
;However, for general S-expressions, we need
(DEFUN NEW-GUTS (SEXP N)
(COND ((OR (ATOM SEXP) (ZERO-P N)) SEXP)
(T (CONS (NEW-GUTS (CAR SEXP) (SUB-1 N))
(NEW-GUTS (CDR SEXP) N )))))
; One may wish to write in error checks - eg that SEXP is ATOMic when N=0, or that
; (numberp N) => N≥0; but they were not required.
; Solution to Question #6 [Auxilary Functions]
; (One could have written a PGM-like function to generate these.)
(DEFUN MAPAPPEND (F U)
(COND ((NULL U) NIL)
(T (APPEND (FUNCALL F (CAR U)) (MAPAPPEND F (CDR U))))))
;Note the TYPO: EVERY returns NIL if f[v] is EVER NIL, else ... [not ALWAYS]
(DEFUN EVERY (F U)
(COND ((NULL U) T)
((FUNCALL F (CAR U)) (EVERY F (CDR U)))
(T NIL)))
(DEFUN ANY (F U)
(COND ((NULL U) NIL)
((FUNCALL F (CAR U))) ; Returns this if it is non-NIL
(T (ANY F (CDR U))))) ; Here only if (↑) was NIL
; Yes, EVERY & ANY are just ANDLIS & ORLIS, respectively
(DEFUN NONE (F U)
(COND ((NULL U) T)
((FUNCALL F (CAR U)) NIL)
(T (NONE F (CDR U)))))
(DEFUN NOT-ALL (F U)
(COND ((NULL U) NIL)
((FUNCALL F (CAR U)) (NOT-ALL F (CDR U)))
(T T))) ; Here when (↑) was NIL, so return T
(DEFUN COUNT (F U)
(COND ((NULL U) 0.)
((FUNCALL F (CAR U)) (ADD1 (COUNT F (CDR U))))
(T (COUNT F (CDR U)))))
; Solution to Question #7 [Ordering]
; There are several ways to write a SORTing function in O( n lg n )
; time. One would (1) write the list into an array, the QUICKSORT it.
; Or, one could utilize the natual binary tree format of the
; S-EXPRESSIONs, using RPLACA/RPLACD's with abandon.
; However, as no one else bothered with such clever schemes,
; I wouldn't either. On to a bubble sort:
(DEFUN SORT (X)
(COND ((OR (NULL X) (NULL (CDR X))) X) ; so much for trivial case
(T (PLACE (CAR X) (SORT (CDR X))))))
(DEFUN PLACE (ELEM LIST)
; This places ELEM into the ordered list LIST.
(COND ((NULL LIST) (LIST ELEM))
((> ELEM (CAR LIST)) (CONS (CAR LIST) (PLACE ELEM (CDR LIST))))
(T (CONS ELEM LIST))))
;; Note: If we are allowed to modify the list cells
;; we could do this much more efficiently.
(DEFUN nSORT (X)
(COND ((OR (NULL X) (NULL (CDR X))) X) ; so much for trivial case
(T (nPLACE (CAR X) (nSORT (CDR X))))))
(DEFUN nPLACE (ELEM LIST)
; This places ELEM into the ordered list LIST.
; We assume LIST is not NIL
(COND ((< ELEM (CAR LIST)) (RPLACD LIST (CONS (CAR LIST) (CDR LIST)))
(RPLACA LIST ELEM))
((NULL (CDR LIST)) (RPLACD LIST (LIST ELEM)))
(T (nPLACE ELEM (CDR LIST))))
LIST ) ; So this is returned.
;Note: This uses N extra LIST cells. While superior to the N*N cells the
;other system would require, these too are extraneous.
;Also, after calling (nSORT X), the value of X may be screwed up.
b) Ordered lists can trivially be scanned for membership in O( n/2 ) time,
[not O( n )], and can be merged (unioned) in O( n+m ) time [not n*(m/2].
Similar wins for Intersection, Deletion, and other set operations
more than offset the n*lg(n) time required for this sorting step.
c) IsSet[ u ] <=> u is a set <=> u is an ordered list with no replications
So:
IsSet[ u ] ← IF n u ∨ n d u THEN T ELSE [a u < ad u] & IsSet[ d u ]
MakeSet[ u ] ← IF n u ∨ n d u THEN u
ELSE PlaceSet[ a u, MakeSet[ d u ] ]
PlaceSet[ e, list ] ← IF n list THEN <e>
ELSEIF e > a list THEN a list . PlaceSet[ e, d list]
ELSEIF e = a list THEN PlaceSet[ e, d list]
ELSEIF e < a list THEN e . list